home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE03 / CLIPBRD / BDAY.PAS next >
Encoding:
Pascal/Delphi Source File  |  1995-06-06  |  3.1 KB  |  106 lines
  1. unit Bday;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ClipBrd;
  8.  
  9. type
  10.  
  11.   TPersonRec = record
  12.     Name: string[100];
  13.     Age: integer;
  14.     BirthDate: TDateTime;
  15.   end;
  16.  
  17.   TBirthDay = class(TComponent)
  18.   private
  19.     { Protected declarations }
  20.     FPersonRec: TPersonRec;
  21.   public
  22.     procedure CopyToClipBoard;
  23.     procedure PasteFromClipBoard;
  24.     property Person: TPersonRec read FPersonRec write FPersonRec;
  25.   end;
  26.  
  27. var
  28.   CF_BIRTHDAY: word;
  29.  
  30. procedure Register;
  31.  
  32. implementation
  33.  
  34. procedure TBirthday.CopyToClipBoard;
  35. const
  36.   CRLF = #13#10;  { Carriage return line feed }
  37.   FormatText = 'Name: %s%sAge: %d%sBirthDate: ';
  38. var
  39.   Data: THandle;
  40.   DataPtr: Pointer;
  41.   Len: Integer;
  42.   TempStr: string;
  43. begin
  44.   { Allocate memory from global heap }
  45.   Data := GlobalAlloc(GMEM_MOVEABLE, SizeOf(FPersonRec));
  46.   try
  47.     DataPtr := GlobalLock(Data);   { Get a pointer to the memory area }
  48.     try
  49.       { Move the data in Buffer to DataPtr    }
  50.       Move(FPersonRec, DataPtr^, SizeOf(FPersonRec));
  51.       ClipBoard.Open; { This is only required if multiple clipboard formats are }
  52.                       { being saved at once. Otherwise, if only one format it being}
  53.                       { sent to the clipboard, don't call it. }
  54.       try
  55.         ClipBoard.SetAsHandle(CF_BIRTHDAY, Data);
  56.         { Now copy also in the CF_TEXT format also }
  57.         with FPersonRec do
  58.           TempStr := Format(FormatText, [Name, CRLF, Age, CRLF])+
  59.              DateToStr(BirthDate);
  60.         ClipBoard.AsText := TempStr;
  61.       finally
  62.         Clipboard.Close; { Only call this if you previously called Clipboard.Open() }
  63.       end
  64.     finally
  65.       GlobalUnlock(Data);               { Unlock the globally allocated memory  }
  66.     end;
  67.   except
  68.     GlobalFree(Data);                   { Free the memory allocated, only if    }
  69.     raise;                              { an exception occurs as this memory is }
  70.   end;                                  { managed by Windows.             }
  71. end;
  72.  
  73. procedure TBirthday.PasteFromClipBoard;
  74. var
  75.   Data: THandle;
  76.   DataPtr: Pointer;
  77.   C: Char;
  78.   Size: Integer;
  79. begin
  80.   Data := ClipBoard.GetAsHandle(CF_BIRTHDAY);   { Get the data on the clipboard }
  81.   try
  82.     if Data = 0 then Exit;                      { Exit is unsuccessful }
  83.     DataPtr := GlobalLock(Data);                { Lock the Global memory object }
  84.     try
  85.       if SizeOf(FPersonRec) > GlobalSize(Data) then Size := GlobalSize(Data);
  86.         { Copy contents of DataPtr to Buffer }
  87.       Move(DataPtr^, FPersonRec, SizeOf(FPersonRec));
  88.     finally
  89.       GlobalUnlock(Data);          { Unlock the global memory object }
  90.     end;
  91.   except
  92.     GlobalFree(Data);              { Free the memory allocated, only if    }
  93.     raise;                         { an exception occurs as this memory is }
  94.   end;                             { managed by the Windows }
  95. end;
  96.  
  97. procedure Register;
  98. begin
  99.   RegisterComponents('Test', [TBirthday]);
  100. end;
  101.  
  102. initialization
  103.   { Register the special clipboard format CF_BIRTHDAY}
  104.   CF_BIRTHDAY := RegisterClipBoardFormat('CF_BIRTHDAY');
  105. end.
  106.